home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue49 / Clinic / TermAppU.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-07-29  |  4.1 KB  |  164 lines
  1. unit TermAppU;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, ExtCtrls, Buttons;
  8.  
  9. type
  10.   TMainForm = class(TForm)
  11.     dlgOpen: TOpenDialog;
  12.     btnLaunch1: TSpeedButton;
  13.     btnLaunch2: TSpeedButton;
  14.     btnTerminate1: TSpeedButton;
  15.     btnTerminate2: TSpeedButton;
  16.     procedure FormCreate(Sender: TObject);
  17.     procedure btnLaunch1Click(Sender: TObject);
  18.     procedure btnLaunch2Click(Sender: TObject);
  19.     procedure btnTerminate1Click(Sender: TObject);
  20.     procedure btnTerminate2Click(Sender: TObject);
  21.   public
  22.     HProcess: THandle;
  23.     ProcessID: DWord;
  24.     ThreadID: DWord;
  25.   end;
  26.  
  27. var
  28.   MainForm: TMainForm;
  29.  
  30. implementation
  31.  
  32. uses
  33.   ShellAPI, TermApp2U;
  34.  
  35. {$R *.DFM}
  36.  
  37. procedure TMainForm.FormCreate(Sender: TObject);
  38. var
  39.   CString: array[0..Max_Path] of Char;
  40. begin
  41.   //Set open dialog to look in Windows directory
  42.   GetWindowsDirectory(CString, SizeOf(CString));
  43.   dlgOpen.InitialDir := CString;
  44. end;
  45.  
  46. procedure TMainForm.btnLaunch1Click(Sender: TObject);
  47. var
  48.   SEI: TShellExecuteInfo;
  49. begin
  50.   if dlgOpen.Execute then
  51.   begin
  52.     FillChar(SEI, SizeOf(SEI), 0);
  53.     with SEI do
  54.     begin
  55.       cbSize := SizeOf(SEI);
  56.       fMask := see_Mask_NoCloseProcess;
  57.       Wnd := Application.Handle;
  58.       lpFile := PChar(dlgOpen.FileName);
  59.       lpParameters := nil;
  60.       nShow := sw_ShowNormal;
  61.     end;
  62.     if ShellExecuteEx(@SEI) then
  63.     begin
  64.       HProcess := SEI.hProcess;
  65.       ProcessID := 0;
  66.       ThreadID := 0;
  67.       WaitForInputIdle(HProcess, Infinite);
  68.       btnLaunch1.Enabled := False;
  69.       btnLaunch2.Enabled := False;
  70.       btnTerminate1.Enabled := True;
  71.       btnTerminate2.Enabled := False
  72.     end
  73.   end;
  74. end;
  75.  
  76. procedure TMainForm.btnLaunch2Click(Sender: TObject);
  77. var
  78.   SI: TStartupInfo;
  79.   PI: TProcessInformation;
  80. begin
  81.   if dlgOpen.Execute then
  82.   begin
  83.     GetStartupInfo(SI);
  84.     Win32Check(CreateProcess(nil, PChar(dlgOpen.FileName), nil, nil, False, 0, nil, nil, SI, PI));
  85.     //Save process information
  86.     HProcess := PI.hProcess;
  87.     ProcessID := PI.dwProcessId;
  88.     ThreadID := PI.dwThreadId;
  89.     btnLaunch1.Enabled := False;
  90.     btnLaunch2.Enabled := False;
  91.     btnTerminate1.Enabled := False;
  92.     btnTerminate2.Enabled := True;
  93.     WaitForInputIdle(HProcess, Infinite);
  94.   end
  95. end;
  96.  
  97. procedure TMainForm.btnTerminate1Click(Sender: TObject);
  98. begin
  99.   TerminateProcess(HProcess, 1);
  100.   btnLaunch1.Enabled := True;
  101.   btnLaunch2.Enabled := True;
  102.   btnTerminate1.Enabled := False;
  103.   btnTerminate2.Enabled := False;
  104. end;
  105.  
  106. function EnumFunc(Wnd: HWnd; TargetPID: DWord): Bool; stdcall;
  107. var
  108.   PID: DWord;
  109. begin
  110.   GetWindowThreadProcessId(Wnd, @PID);
  111.   if PID = TargetPID then
  112.     PostMessage(Wnd, wm_Close, 0, 0);
  113.   Result := True;
  114. end;
  115.  
  116. function CheckAppClosed(Process: THandle): Boolean;
  117. var
  118.   OldTime: TDateTime;
  119. const
  120.   mrEndTask = 100;
  121.   mrWait = 101;
  122. begin
  123.   Result := False;
  124.   OldTime := Now;
  125.   //Loop till either 10 sec is up, or program has terminated
  126.   repeat
  127.     //Do quick check on the app, but not long
  128.     //enough to block (hang) this UI thread
  129.     case WaitForSingleObject(Process, 100) of
  130.       Wait_Object_0: Result := True;
  131.       Wait_Failed: RaiseLastWin32Error;
  132.     end;
  133.     //Stop UI from hanging
  134.     Application.ProcessMessages;
  135.     //If user wants to shut, then fine
  136.     if Application.Terminated then
  137.       Break;
  138.   until Result or (Now > OldTime + 10 / SecsPerDay);
  139.  
  140.   if not Result then //timeout has passed
  141.     case ShutAppForm.ShowModal of
  142.       mrEndTask:
  143.       begin
  144.         TerminateProcess(Process, 1);
  145.         Result := True
  146.       end;
  147.       mrWait: {do nothing - we will loop again} ;
  148.       mrCancel: Result := True;
  149.     end
  150. end;
  151.  
  152. procedure TMainForm.btnTerminate2Click(Sender: TObject);
  153. begin
  154.   EnumWindows(@EnumFunc, LPARAM(ProcessID));
  155.   //May need to do this whole 10 sec wait repeatedly
  156.   repeat until CheckAppClosed(HProcess);
  157.   btnLaunch1.Enabled := True;
  158.   btnLaunch2.Enabled := True;
  159.   btnTerminate1.Enabled := False;
  160.   btnTerminate2.Enabled := False;
  161. end;
  162.  
  163. end.
  164.